;; file     : dsmouse.scm
;; created  : June 28, 1995
;; author   : GW Celniker
;; copyright: Advanced Geometry Concepts, All Rights Reserved (c) 1995
;; synopsis : Control program to set up the 3D toolkit mouse hook and
;;            rubberband functions to support the following mouse I/O
;;            for a deformable model
;; contains : ds:mouse	( face )
;;            ds:mouse-help	
;;            ds:mouse-view-help
;;            ds:select-face . number of elems in each dir
;;            ds:select-edge . number of elems
;;            ds:set-mouse-slider
;;            ds:get-mouse-slider
;;  Giant comment at the end for manual documentation

;; the DS_Rotate and DS_Zoom functions are taken directly
;; from the example file "3dt1.3/examples/camera.scm"
;; these functions use compound functions defined in that file
;; so make sure that the "camera.scm" file is loaded prior to use
(provide 'DSmouse)
(require 'camera "camera.scm")

; ds:select-face
; Prompt user for a pick event to select a face
; to bind to the (ds:mouse) rubberband driver
; and the ds-demo (ds-model) global variable
; when the pick fails to select a sculptable face
; the current bindings are left unchanged

(define data-ds:mouse-slider-tag)
(define data-ds:mouse-slider-gain-inc)
(define (ds:set-mouse-slider tag gain-inc)
  (set! data-ds:mouse-slider-tag tag)
  (set! data-ds:mouse-slider-gain-inc gain-inc))
(define (ds:get-mouse-slider)
  (list data-ds:mouse-slider-tag data-ds:mouse-slider-gain-inc))

(define (ds:add-face . opt) ;; opt = number of elements for each dir
 (let ( (this-model '()) 
        (n (if (not (null? opt)) (car opt) 3))
      )
    (let ( (del (/ 1.0 n))
           (a (list))
         )
      (display "  Pick Face to Link to Current ds-model:")
      (set! this-model (pick:face (read-event) 1 ))
      (display this-model)
      (cond ((not this-model)
             (display "\n  No Face picked - try (ds:add-face) again\n"))
            (else
          
              ; faces with just one elem are split into more
              (display "check elem count")
              (cond ( (= 1 (car (ds:get-elem-count this-model)))
                      (display "  Splitting face into elems \n")
                      (do ((i 1 (+ i 1))) ((= i n))
                          (set! a (append a (list (par-pos (* i del)(* i del)))))
                          )
                      (ds:split-domain this-model 1 a)
                    )
              )
          
              ; when ds-model is being used - link the face
              (cond ( (entity? ds-model)
                      ; execute the link-face command
                      (display "linking faces")
                      (ds:link-face ds-model this-model)
                      (view:refresh)
                    ) ; end ds-model is being used clause
                    ( else ; treat the face likd ds:select-face
                      (set! ds-model this-model)
                      (ds:mouse ds-model)
                    ) ; end else clause
              ) ; end cond clause
            ) ; end else didn't pick a face clause
        ) ; end cond clause
  ))) ; close two lets and the define

(define (ds:pick-face . opt) 
  (if (not (null? opt))
  (ds:select-face opt)
  (ds:select-face)))

(define (ds:select-face . opt)  ; opt = number of elems in each dir
  (let ((this-model '())
        (n (if (not (null? opt)) (car opt) 3)))
    (let ((del (/ 1.0 n))
          (a (list)))
      
      (rbd:clear)
      (display "  Pick Face to Sculpt: ")
      (set! this-model (pick:face (read-event) 1 ))
      (display this-model)
      (cond ( (not this-model)
              (display "\n  No Face picked - try (ds:select-face) again\n")
            )
            (else
              
              ; faces with just one elem are split into more
              (cond ((= 1 (car (ds:get-elem-count this-model)))
                     (display "  Splitting face into elems \n")
                     (do ((i 1 (+ i 1))) ((= i n))
                         (set! a (append a (list (par-pos (* i del)(* i del)))))
                         )
                     (ds:split-domain this-model 1 a)))
              
              ; Use globals to bind this face to mouse and demo funcs
              (set! ds-model this-model)
              (ds:mouse ds-model)
              
              (view:refresh)
            ) ; close out else clause
      ) ; close out cond clause
 ))) ; close two lets and the define

(define (ds:pick-edge . opt) 
  (if (not (null? opt))
  (ds:select-edge opt)
  (ds:select-edge)))

(define (ds:select-edge . opt)  ; opt = number of elems
  (let ((this-model '())
        (n (if (not (null? opt)) (car opt) 9)))
    (let ((del (/ 1.0 n))
          (a (list)))
      
      (rbd:clear)
      (display "  Pick Edge to Sculpt: ")
      (set! this-model (pick:edge (read-event) ))
      (display this-model)
      (cond ((not this-model)
             (display "\n  No Edge picked - try (ds:select-edge) again\n"))
            (else
              
              ; edge with just one elem are split into more
              (cond ((= 1 (car (ds:get-elem-count this-model 1)))
                     (display "  Splitting edge into elems \n")
                     (do ((i 1 (+ i 1))) ((= i n))
                         (set! a (append a (list (par-pos (* i del)(* i del)))))
                         )
                     (ds:split-domain this-model 1 a)))
              
              ; Use globals to bind this face to mouse and demo funcs
              (set! ds-model this-model)
              (ds:mouse ds-model)
              
              ; refresh graphics 
              (view:refresh)
              )) ; close out cond clause
      ))) ; close two lets and the define

(define ds:mouse-help
  (lambda ()
    (display "            ds:mouse Function Map\n")
    (display "NOTE: Bind a load to the slider function with\n")
    (display "      (ds:set-mouse-slider tag gain_inc)\n")
    (display "NOTE: Release select keys after mouse moves begin\n\n")
    (display "---------+--------------+-----------+---------+\n" )
    (display "         |    Lft       |    Rgt    | Rgt_Lft |\n" )
    (display "---------+--------------+-----------+---------+\n" )
    (display "  Plain  |  RotView     | ZoomView  | PanView |\n" )
    (display "---------+--------------+-----------+---------+\n" )
    (display "  Shift  |Track Z/Length|Add/Tog_Cpt|\n" )
    (display "---------+--------------+-----------+\n" )                         
    (display " Shft-drg|              | Add Patch |\n" )
    (display "---------+--------------+-----------+\n" )
    (display "  Ctrl   | Track XY/Dir |  Add_Ppt  |\n" )
    (display "---------+--------------+-----------+\n" )
    (display "Shft_Ctrl| Slide/Track  |  Rm_Tag   |\n" )
    (display "---------+--------------+-----------+\n" )
    )
  )
(define ds:mouse-view-help
  (lambda ()
    (display "            ds:mouse Function Map\n")
    (display "    +-------------+-----------+---------+\n" )
    (display "    |    Lft      |    Rgt    | Rgt_Lft |\n" )
    (display "    +-------------+-----------+---------+\n" )
    (display "    |  RotView    | ZoomView  | PanView |\n" )
    (display "    +-------------+-----------+---------+\n" )
    )
  )

;; Lft Column     = Actions taken when left key is pressed
;; Rgt Column     = Actions taken when right key is pressed
;; Rgt_Lft Column = Actions taken when left and right keys are pressed
;; Plain row      = Actions taken when mouse keys are pressed alone
;; Shift row      = Actions taken when mouse keys and shift key are pressed
;; Shft-drg row   = Actions taken when mouse and shift keys are pressed then dragged
;; Ctrl row       = Actions taken when mouse keys and ctrl key are pressed
;; Shft_Ctrl row  = Actions taken when mouse keys, shift and ctrl keys are pressed
;; Cpt            = Constraint Point
;; Ppt            = Pressure Pt Load
;; RotView        = virtual animateball manipulation of the view
;; ZoomView       = track cursor.y to animate view focal distance
;; PanView        = track cursor to animate view focal point
;; Track_Cpt_Z    = move a Cpt parallel to the Z axis/an end-pt along its vector
;; Track_Cpt_XY   = move a Cpt parallel to the XY plane/an end-pt on a hemisphere
;; Slide_gain     = track cursor.x to animate one load's gain see (ds:set-mouse-slider)
;;                  or move an end-pt independently
;; Add/Tog_Cpt    = When no constraint is highlighted,
;;                       Add Cpt at intersection of pick-ray and surface
;;                  Else Toggle highlighted constraint's enabled/disabled state
;; Add_Ppt        = Add Ppt at intersection of pick-ray and surface
;; Rm_Tag         = Remove highlighted Cpt or Ppt.
;;

(define ds:mouse
  ;; the name space made by this let defines shared variable
  ;; values that can be affected by the hook and rbd functions
  (let ( ;; shared variables for deformable model update
         (this-model '())       ;; tgt face for all edits (ds:mouse face)
         (current-tag -1)       ;; -1=None,
                                ;; 0<=Tgt Pt to be edited
                                ;; -100>= control Pt to be edited
                                ;; -99=tmp_shape
         (last-tag -1)          ;; last found tag value
         (curve-dmod-tgt 0)     ;; tgt for ds:pick-position and ds:pick-par-pos
                                ;; for special case of picking a tracking curve
         (current-pt-index 0)   ;; select which image-pt in current-tag
         (current-tag-type -1)  ;; -1=NoSuchTag,1=ctrl_pt,2=Ppr,3=Dpr,
                                ;; 14=vector_load,15=attractor
                                ;; 4=Spr,5=Spr_set,6=Load_crv
                                ;; 7=dyn_load,8=pt_cstrn,9=Seam_pt_csytrn,
                                ;; 10=Curve_cstrn, 11=Seam_crv_cstrn,16=link_cstrn,18=link_load
                                ;; 17=area_cstrn, 18=link_load
                                ;; 19=Track_pos_crv, 20=Track_tan_crv
                                ;; 21=Track_link_crv
                                ;; 13=deformable_curve,12=deformable_surface
         (independent_track 1)  ;; 1=move end-pts together,1=move independently
         (dist-press-tag -1)    ;; -1=no dist press
         (xyz-pos '())          ;; shared position for mv cpt and highlight
         (last-xyz-pos '())     ;; shared position for highlight
         (uv-pos '())           ;; shared position for adding pts
         (gain 1000)            ;; shared gain value for editing loads
         (mouse-mode 0)    ;; let mouse-down tell mouse-up to execute a function
         ;; 0 - no function to execute
         ;; 1 -  if last-pe == pe  execute DS_Add_cstrn_pt
         ;;     else                       exectue DS_Add_patch
         
         ;; shared variables for DS_Add_Track (adds patches and pt_cstrns)
         ;; also uses xyz-pos, last-xyz-pos, and uv-pos
         (last-pos-list '())  ;; pos list used for clearing box highlight
         (last-box-p0 '())  ;; pos used for clearing box-p0 highlight
         (box-p0 '()) ;; 1st box position picked with last-pe
         (box-p1 '()) ;; 2nd box position
         (box-u0 '())   ;; uv par-pos picked with box-p0
         (box-u1 '())  ;; uv par-pos picked with box-p1
         (box-tag0 '())  ;; patch-tag picked with box_p0 or -1
         (box-tag1 '())  ;; patch-tag picked with box_p1 or -1
         
         ;; shared variables for viewing update
         (last-pe '()) ;;
         (view '())  ;;
         (vpwidth '())
         (vpheight '())  ;;
         (vpsize '())  ;;
         (rb-procs (make-vector 7 '())) ;;
         ) ; end 1st let name-block
    ;; the next let box defines a set of subroutines common to action
    ;; subroutines to be defined in the let box that follows
    (let (
           ;; defines DS_Search_Tgt(), DS_view_set(), DS_Draw_Pt(),
           ;;             DS_Draw_Line(), DS_Draw_Pline(),
           (DS_Search_Tgt
             (lambda (pe)
               (set! last-tag current-tag)
               (set! current-tag (ds:pick-tag-id this-model pe))
               (set! current-pt-index (cadr current-tag))
               (set! current-tag (car current-tag))
               (set! curve-dmod-tgt 0) ; default value

               ;; when requested - print tag and pt-index
               (cond
                 ;; case print-tags and found a tag
                 ((and (= 1 ds-display-tag-flag)
                       (not (= -1 current-tag))
                       (not (= current-tag last-tag)))
                  (display "current-tag = ") (display current-tag)
                  (display ", current-pt-index = ") (display current-pt-index)
                  (display "(") (display (ds:get-type-string current-tag-type))
                  (display ") \n")
                 )) ; end cond to print tag and point index

               (cond
                 ;; case = ds:pick-tag-id hit something
                 ((not (= -1 current-tag))   ;     not a miss
                  (set! current-tag-type
                        (ds:get-tag-type this-model current-tag))
                  ; (display "\n   current-tag-type = ")
                  ; (display current-tag-type)

                  ; switch between tag objects and dmods
                  (cond (
                        ; check for a found tag object
                         (and (not (= 12 current-tag-type))  ;     not a deformable surf
                              (not (= 13 current-tag-type))  ; and not a deformable crv
                              (not (= 19 current-tag-type))  ; and not a tracking pos crv
                              (not (= 20 current-tag-type))  ; and not a tracking tan crv
                              (not (= 21 current-tag-type))) ; and not a tracking curv crv
                         ; find an xyz-pt for the tag object
                         (set! xyz-pos (ds:get-pt-xyz this-model
                                                      current-tag
                                                      current-pt-index))
                        ) ; end found a tag object condition

                        ; check for a found curve dmod
                        ((or (= 13 current-tag-type)  ;    a deformable crv   
                             (= 19 current-tag-type)  ; or a tracking pos crv 
                             (= 20 current-tag-type)  ; or a tracking tan crv 
                             (= 21 current-tag-type)) ; or a tracking curv crv
                                                          
                         ; pick position from the current-tag
                         (set! curve-dmod-tgt current-tag)
                         (set! xyz-pos (ds:pick-position this-model pe ))
                        ) ; end found a deformable curve condition

                       ; default = didn't find anything to track
                       (else
                        (set! current-tag-type -1)
                       ) ; end found a deformable surface condition
                  ) ; end cond switch on tag object/dmod find
                  ; (display ",   current-tag-type = ")
                  ; (display current-tag-type)
                  ) ; end ds:pick-tag-id hit a tag object case
                 ;; case = ds:pick-tag-id missed and def-curve
                 ((edge? this-model)
                  ; (display "search edge model - ")
                  (set! xyz-pos (ds:pick-position this-model pe))
                  (cond ((position? xyz-pos)
                         (set! current-tag-type 13)
                         ; (display "draw edge \n")
                         (set! current-tag -99))
                        (else (set! current-tag-type -1)
                              ; (display "draw no edge\n")
                              ))) ; end missed and edge case
                 ;; case = ds:pick-tag-id missed and def-surface
                 (else
                   (set! current-tag-type -1)
                 ) ; end else
                ) ; end cond on hit something or missed everything
               )) ; end lambda, DS_Search_Tgt
           
           (DS_view_set
             (lambda (pe)
               (set! view (event:view pe))
               (set! last-pe pe)
               (let ((viewport (view:viewport view)))
                 (set! vpwidth (- (cadddr viewport) (car viewport)))
                 (set! vpheight (- (caddr viewport) (cadr viewport)))
                 )
               (set! vpsize (max vpwidth vpheight))
               )) ; end DS_view_set
           
           (DS_Draw_Pt
             (lambda (image_pt) ;; image_pt of type position
               ;; (display "ENTERING DS_Draw_Pt\n")
               (if view
                   (begin
                     (view:set-fg-color 5)
                     (view:set-rb-mode #t)
                     ;; (display "image_pt = ")
                     ;; (display image_pt) (display "\n")
                     (view:draw-point image_pt)
                     (view:set-rb-mode #f)
                     ))
               )) ; end DS_Draw_Pt
           
           (DS_Draw_Pline
             (lambda (pt_list)  ;; all entries in list of type position
               ;(display "enter DS_Draw_Pline\n")
               (if view
                   (begin
                     (view:set-fg-color 5)
                     (view:set-rb-mode #t)
                     (view:draw-polyline pt_list)
                     (view:set-rb-mode #f)
                     ))
               )) ; end DS_Draw_Pline
           
           ) ; end 2nd let variable definitions - begin 2nd let body
      ;; The name space made by this next let defines the set of
      ;; hook and rbd functions that comprise the action commands
      ;; of the ds:mouse rubberband driver
      (let (
             ;; defines DS_Highlight_Pt(), DS_Highlight_Solve(),
             ;;         DS_Add_Press_Pt()
             ;;         DS_Add_Cstrn_Pt(), DS_Add_Patch(), DS_Toggle_Cstrn(),
             ;;         DS_Rm_Tag(), DS_Track_Z_Gain(), DS_Track_XY_Gain(),
             ;;         DS_Track_Dist_Gain(), DS_Add_Track(), DS_Pan(),
             ;;         DS_Zoom(), DS_Rotate()
             (DS_Highlight_Pt
               (lambda (self pe)
              ;;    (display "DS_Highlight_Pt\n")   
                 (DS_Search_Tgt pe)
                 (cond ((position? last-xyz-pos)
                        (DS_Draw_Pt last-xyz-pos)
                        ; (display "draw 0 \n")     
                        (set! last-xyz-pos '())))
              ;;    (display "DS_higlight_pt: current-tag [")  
              ;;    (display current-tag) (display "] [")    
              ;;    (display xyz-pos) (display "]\n")      
                 (cond ((and (not (= -1 current-tag))
                             (position? xyz-pos))
                        (view:refresh)
                        (DS_Draw_Pt xyz-pos)
                        ; (display "draw 1 - ")        
                        (set! last-xyz-pos xyz-pos))
                       ; (else (set! last-xyz-pos '()))
                       )
                 )) ; end DS_Highlight_Pt
             
             (DS_Highlight_Solve
               (lambda (self pe)
                 ;; (display "DS_Highlight_Solve\n")
                 (cond ((position? last-xyz-pos)
                        (DS_Draw_Pt last-xyz-pos)
                        (set! last-xyz-pos '())))
                 (ds:solve this-model)
                 (DS_Search_Tgt pe)
                 (cond ((and (not (= -1 current-tag))
                             (position? xyz-pos))
                        (DS_Draw_Pt xyz-pos)
                        (set! last-xyz-pos xyz-pos))
                       ; (else (set! last-xyz-pos '()))
                       )
                 )) ; end DS_Highlight_Solve
             
             (DS_Add_Press_Pt  ;; causes repaint
               (lambda (pe)
                 ; (display "start DS_Add_Press_Pt\n")
                 ; as a non-sequitor set ds-sim-count to 1000
                 ; this will cause the do-loop in function
                 ; ds-sim-loop to exit
                 (set! ds-sim-count 1000)
                 
                 ; now back to the add press pt function
                 (set! current-tag (ds:add-pt-press this-model 1 pe 0))
                 (set! current-tag-type 2)
                 (display "DS_Add_Press_Pt(tag = " )
                 (display current-tag)
                 (display ")\n")
                 (set! last-xyz-pos '())  ;; clear highlight memory
                 )) ; end DS_Add_Press_Pt
             
             (DS_Add_Cstrn_Pt  ;; causes repaint
               (lambda (pe)
                 ;; (display "start DS_Add_Cstrn_Pt\n")
                 ;; (display "  current-tag-type = ")
                 ;; (display current-tag-type)
                 ;; (display ",  current-tag = ")
                 ;; (display current-tag)
                 ;; (display "\n")
                 (set! current-tag (ds:add-pt-cstrn 
                                     this-model 
                                     (if (= 0 curve-dmod-tgt) 1 curve-dmod-tgt)
                                     "position" 
                                     pe))
         ;;;(if (or (= 19 current-tag-type)  ; a tracking pos curve
         ;;;        (= 20 current-tag-type)  ; a tracking tan curve
         ;;;        (= 21 current-tag-type)) ; a tracking curvature curve
         ;;;  (set! current-tag (ds:add-pt-cstrn this-model curve-dmod-tgt "position" pe))
         ;;;  (set! current-tag (ds:add-pt-cstrn this-model 1 "position" pe))
         ;;; ) ; end if a tracking dmod check
                 (set! current-tag-type 8)
                 (display "DS_Add_Cstrn_Pt(tag = " )
                 (display current-tag)
                 (display ")\n")
                 (set! last-box-p0 '())   ;; clear highlight memory
                 (set! last-xyz-pos '())  ;; clear highlight memory
                 )) ;  end DS_Add_Cstrn_Pt
             
             (DS_Add_Patch
               ;; the par-pos uv1 and uv2 amy not be a min and max pair
               (lambda (uv1 uv2)
                 (let ( (pt1 (par-pos (if (< (par-pos:u uv1) (par-pos:u uv2))
                                          (par-pos:u uv1) (par-pos:u uv2))
                                      (if (< (par-pos:v uv1) (par-pos:v uv2))
                                          (par-pos:v uv1) (par-pos:v uv2))  ))
                        (pt2 (par-pos (if (> (par-pos:u uv1) (par-pos:u uv2))
                                          (par-pos:u uv1) (par-pos:u uv2))
                                      (if (> (par-pos:v uv1) (par-pos:v uv2))
                                          (par-pos:v uv1) (par-pos:v uv2))  ))
                        ) ; end let* name-block - begin let body
                   
                   ; (display "start DS_Add_Patch\n")
                   (display "pt1 = ") (display pt1) (display "\n");; 
                   (display "pt2 = ") (display pt2) (display "\n");;
                   (set! current-tag (ds:add-patch this-model 1 1 pt1 pt2 pt2 5))
                   (solve)                          ;; 
                   ; tag-type: 13=deformable curve,12=deformable surface
                   (cond
                     ;; add_patch succeeded
                     ((> current-tag 0)
                      (set! current-tag-type (if (face? this-model) 12 13))
                      (display "DS_Add_Patch(tag = ")
                      (display current-tag)
                      (display ")\n")
                      (set! last-pos-list '()) ;; clear highlight memory
                      ) ; end add-patch succeeded
                     ;; else add-patch failed
                     (else (set! current-tag-type -1)
                           (display "DS_Add_Patch - failed\n")
                           ) ); end else, and conditional
                   ) ; end let
                 )) ; end lambda, DS_Add_Patch
             
             (DS_Toggle_Cstrn   ;; causes repaint
               (lambda ()
                 ; (display "start DS_Toggle_Cstrn\n")
                 ;; switch between seam and link_cstrns 
                 ;; and other cstrns
                 (cond
                   ;; case = seam_cstrns
                   ((or (= current-tag-type 9)   ;seam pt_cstrn
                        (= current-tag-type 11)  ;seam crv_cstrn
                        (= current-tag-type 16)  ;link crv_cstrn
                        (= current-tag-type 18)) ;link crv_load
                    (ds:toggle-seam this-model (ds:get-tag-patch this-model current-tag))
                    ;; inform the public
                    (display "DS_Toggle_Cstrn(Tag = ") (display current-tag)
                    (if (= current-tag-type 9)
                        (display ") Seam_Pt c0/c1/c2 state\n")
                        (display ") Seam_Crv c0/c1/c2 state\n"))
                    ) ; end case = seam_cstrns
                   ;; case = non-seam cstrns that can be toggled
                   ((ds:toggle-cstrn this-model current-tag)
                    ;; inform the public
                    (display "DS_Toggle_Cstrn(Tag = ") (display current-tag)
                    (cond ((= current-tag-type 8)
                           (display ") Pt_Cstrn on/off state\n"))
                          ((= current-tag-type 10)
                           (display ") Crv_cstrn on/off state\n"))
                          ((= current-tag-type 6)
                           (display ") Crv_load on/off state\n"))
                          ((= crrent-tag-type  17)
                           (display ") Area_cstrn on/off state\n"))
                        )
                    ) ; end successful non-seam cstrn toggle
                   ;; case = non-seam-cstrn failed
                   ( else
                     (display "DS_Toggle_Cstrn(Tag = ")
                     (display current-tag)
                     (display ")\n      Sorry - this cstrn can't be disabled\n"))
                   ) ; end seam/non-seam condition
                 (set! last-xyz-pos '())  ;; clear highlight memory
                 )) ; end DS_Toggle_Cstrn
             
             (DS_Rm_Tag         ;; causes repaint
               (lambda (pe)
                 ; (display "start DS_Rm_Tag\n")
                 (DS_Search_Tgt pe)
                 (display "DS_Rm_Tag(tag = " )
                 (display current-tag)
                 (display ") type = " )
                 (display current-tag-type)
                 ;; switch on current-tag-type
                 (cond
                   ((or (= 8 current-tag-type)
                        (= 9 current-tag-type))
                    (display ": Constraint Pt\n")
                    (if (= 0 (ds:rm-tag-object this-model current-tag))
                        (display "      Sorry - this pt_cstrn not deletable\n")))
                   ((= 2 current-tag-type)
                    (display ": Pressure Pt\n")
                    (ds:rm-tag-object this-model current-tag))
                   ((= 6 current-tag-type)
                    (display ": Curve Load\n")
                    (ds:rm-tag-object this-model current-tag))
                   ((= 14 current-tag-type)
                    (display ": Vector Load\n")
                    (ds:rm-tag-object this-model current-tag))
                   ((= 15 current-tag-type)
                    (display ": Attractor\n")
                    (ds:rm-tag-object this-model current-tag))
                   ((= 4 current-tag-type)
                    (display ": Spring Pt\n")
                    (ds:rm-tag-object this-model current-tag))
                   ((or (= 10 current-tag-type)
                        (= 11 current-tag-type))
                    (display ": Curve Constraint\n")
                    (if (= 0 (ds:rm-tag-object this-model current-tag))
                        (display "      Sorry - this crv_cstrn not deletable\n")))
                   ((= 17 current-tag-type)
                    (display ": Area constraint\n")
                    (ds:rm-tag-object this-model current-tag))
                   (else (display ":Not a type to be removed\n"))
                   ) ; end conditional on current-tag-type
                 (set! current-tag -1)
                 (set! current-tag-type -1)
                 (set! last-xyz-pos '())  ;; clear highlight memory
                 )) ; end lambda, DS_Rm_Tag
             
             (DS_Track_Z_Gain  ;; causes repaint or no-current-tag-type
               (lambda (self pe)
                 (cond
                   ( (or ( =  8 current-tag-type)  ;; for pt_cstrn
                         ( =  9 current-tag-type)  ;; for seam pt_cstrn
                         ( = 14 current-tag-type)  ;; for vector-load
                         ( = 15 current-tag-type)  ;; for attractor
                         ( =  4 current-tag-type)) ;; for springs
                      ;(display "\ncurrent-tag     : ") (display current-tag)
                      ;(display "\ncurrent-pt-index: ") (display current-pt-index)
                      ;(display "\npe              : ") (display pe)
                      ;(display "\n")
                     (ds:set-pt-xyz this-model
                                    current-tag current-pt-index 
                                    2 pe
                                    independent_track)
                     (ds:solve this-model 1)
                     (set! last-xyz-pos '())  ;; clear highlight memory
                     )
                   ((= 2 current-tag-type) ;; for pt_press
                    (let* ((dy (/ (- (event:y last-pe) (event:y pe)) vpheight))
                           (dx (/ (- (event:x pe) (event:x last-pe)) vpwidth ))
                           (del (if (> (abs dy) (abs dx)) dy dx)))
                      (begin
                        ; (display "del-gain = ")(display (* del gain))(display "\n")
                        (ds:set-load-gain this-model current-tag (* del gain) #t)
                        (ds:solve this-model)
                        (set! last-pe pe)
                        (set! last-xyz-pos '())  ;; clear highlight memory
                        )))
                   ((= 1 current-tag-type)  ;; for control_pts
                    (ds:set-pt-xyz this-model
                                   current-tag current-pt-index 
                                   2 pe
                                   independent_track)
                    (set! last-xyz-pos '())  ;; clear highlight memory
                    )
                   (else
                     (if (position? last-xyz-pos)
                         (DS_Draw_Pt last-xyz-pos)
                         (set! last-xyz-pos '()))
                     (DS_Search_Tgt pe)))
                 )) ; end DS_Track_Z_Gain
             
             (DS_Track_XY_Gain   ;; causes repaint or no-current-tag-type
               (lambda (self pe)
                 (cond
                   ((or ( =  8 current-tag-type)  ;; for pt_cstrn
                        ( =  9 current-tag-type)  ;; for seam_pt_cstrn
                        ( = 14 current-tag-type)  ;; for vector_loads
                        ( = 15 current-tag-type)  ;; for attractors
                        ( =  4 current-tag-type)) ;; for springs
                    (ds:set-pt-xyz this-model
                                   current-tag current-pt-index 
                                   1 pe
                                   independent_track)
                    (ds:solve this-model)
                    (set! last-xyz-pos '())  ;; clear highlight memory
                    )
                   ((= 2 current-tag-type)      ;; for pt_press
                    (let* ((dy (/ (- (event:y last-pe) (event:y pe)) vpheight))
                           (dx (/ (- (event:x pe) (event:x last-pe)) vpwidth ))
                           (del (if (> (abs dy) (abs dx)) dy dx)))
                      (begin
                        ; (display "del-gain = ")(display (* del gain))(display "\n")
                        (ds:set-load-gain this-model current-tag (* del gain) #t)
                        (ds:solve this-model)
                        (set! last-pe pe)
                        (set! last-xyz-pos '())  ;; clear highlight memory
                        )))
                   ((= 1 current-tag-type)       ;; for control points
                    (ds:set-pt-xyz this-model
                                   current-tag current-pt-index 
                                   1 pe
                                   independent_track)
                    (set! last-xyz-pos '())  ;; clear highlight memory
                    )
                   (else
                     (if (position? last-xyz-pos)
                         (DS_Draw_Pt last-xyz-pos)
                         (set! last-xyz-pos '()))
                     (DS_Search_Tgt pe)))
                 )) ; end DS_Track_XY_Gain
             
             (DS_Track_Dist_Gain  ;; causes repaint
               (lambda (self pe)
                 (let* ((dy (/ (- (event:y last-pe) (event:y pe)) vpheight))
                        (dx (/ (- (event:x pe) (event:x last-pe)) vpwidth ))
                        (del (if (> (abs dy) (abs dx)) dy dx)))
                   (begin
                     (display "added gain to tag: ")
                     (display data-ds:mouse-slider-tag)
                     (display "  ")
                     (display (* del data-ds:mouse-slider-gain-inc))
                     (display "\n")
                     ; (if (= -1 dist-press-tag)
                     ; (set! dist-press-tag (ds:add-dist-press this-model 1 0)))
                     ; (display "del-gain = ")(display (* del gain))(display "\n")
                     ; (ds:set-load-gain this-model dist-press-tag (* del gain) #t)
                     ; (display "del-gain = ") (display (* del gain) ) (display "\n")
                     (ds:set-load-gain this-model
                                       data-ds:mouse-slider-tag
                                       (* del data-ds:mouse-slider-gain-inc) #t)
                     (ds:solve this-model)
                     (set! last-pe pe)
                     (set! last-xyz-pos '())  ;; clear highlight memory
                     ))
                 )) ; end DS_Track_Dist_Gain
             
             (DS_Add_Track   ;; causes repaint
               (lambda (self pe)
                 ;; assumes mouse-down set box-p0, box-u0, box-tag0
                 ; (display "enter DS_Add_Track")
                 (set! box-p1 (ds:pick-position this-model pe 
                                (if (= 0 curve-dmod-tgt) 2 curve-dmod-tgt) ))
                 (set! box-u1 (ds:pick-par-pos this-model pe 
                                (if (= 0 curve-dmod-tgt) 2 curve-dmod-tgt) ))
                 (set! box-tag1 (ds:get-active-patch this-model))
                 
                 ;; clear the last rendering
                 (cond ((not (null? last-pos-list))
                        (DS_Draw_Pline last-pos-list)
                        (set! last-pos-list '())) ; end last rendered a box
                       ((not (null? last-box-p0))
                        (DS_Draw_Pt last-box-p0)
                        (set! last-box-p0 '())) ; end last rendered a pt
                       ) ; end clear last rendering conditional
                 
                 ;(display " -box-tags = ") (display box-tag0) (display "  ") (display box-tag1)
                 ;(display " box-us = ") (display box-u0) (display "  ") (display box-u1)
                 
                 ;; when both pick points are in the same dmod
                 (if (= box-tag0 box-tag1)
                     ;; switch on FACE/EDGE and uv-pts close or far
                     (cond
                       ;; case = faces and uv-pts far apart
                       ((and (face? this-model)
                             (< 0.04 (abs (- (par-pos:u box-u0) (par-pos:u box-u1))))
                             (< 0.04 (abs (- (par-pos:v box-u0) (par-pos:v box-u1)))))
                        ;; build opposite corner uv-pts for box rendering
                        (let* ( (u0 (par-pos (par-pos:u box-u0) (par-pos:v box-u1)))
                                (u1 (par-pos (par-pos:u box-u1) (par-pos:v box-u0)))
                                (p0 (ds:get-xyz this-model box-tag0 u0))
                                (p1 (ds:get-xyz this-model box-tag0 u1))
                                ) ; end let name-block - begin let body
                          ;(display " - uv-pts different")
                          ;(display " u0 u1 - ") (display u0) (display " ") (display u1) (display "\n")
                          ;; convert box-u0 and box-u1 into pos-list - highlight box
                          (set! last-pos-list (list box-p0 p0 box-p1 p1 box-p0))
                          (DS_Draw_Pline last-pos-list)
                          )) ; end let*, far on face branch
                       ;; case = uv-pts far on an edge
                       ((and (edge? this-model)
                             (< 0.04 (abs (- (par-pos:u box-u0) (par-pos:u box-u1)))))
                        ;(display " - uv-pts different\n")
                        ;; convert box-u0 and box-u1 into pos-list - highlight box
                        (set! last-pos-list (list box-p0 box-p1))
                        (DS_Draw_Pline last-pos-list)
                        ) ; end far on edge branch
                       ;; case = uv-points close enough to count as just one point
                       (else
                         ;; set box-u1 = box-u0 and higlight box-p0
                         ;(display " - uv-pts the same\n")
                         (set! box-u1 box-u0)
                         (set! last-box-p0 box-p0)
                         (DS_Draw_Pt last-box-p0)
                         ) ; end uv-pts close branch
                       ) ; end close/far uv-pos branching
                     ) ; end if both picks in same dmod check
                 )) ; end lambda, DS_Add_Track
             
             (DS_Pan            ;; causes repaint
               (lambda (self pe)
                 (let ((dx (* (- (event:x last-pe) (event:x pe))
                              (/ (view:width view) vpwidth)))
                       (dy (* (- (event:y pe) (event:y last-pe))
                              (/ (view:height view) vpheight)))
                       )
                   (camera:move
                     (gvector:+ (gvector:scale (camera:right view) dx)
                                (gvector:scale (camera:up view) dy)
                                )
                     view)
                   )
                 (set! last-pe pe)
                 (set! last-xyz-pos '())  ;; clear highlight memory
                 )) ; end DS_Pan
             
             (DS_Zoom           ;; causes repaint - set highlight mem
               (lambda (self pe)
                 (let* ((dy (- (event:y pe) (event:y last-pe)))
                        (scale (if (> 0 dy)
                                   (+ 1 (/ dy vpheight))
                                   (/ 1 (+ 1 (/ (- dy) vpheight)))
                                   ))
                        )
                   (camera:zoom scale view)
                   )
                 (set! last-pe pe)
                 (set! last-xyz-pos '())  ;; clear highlight memory
                 )) ; end DS_Zoom
             
             (DS_Rotate         ;; causes repaint - set highlight mem
               (lambda (self pe)
                 (let ((dx (- (event:x last-pe) (event:x pe)))
                       ; The origin for pick-events is the upper left corner
                       ; rather than the lower left corner, so we have to reverse
                       ; the y values when computing the direction moved.
                       (dy (- (event:y pe) (event:y last-pe)))
                       )
                   (let ((axis (gvector:+ (gvector:scale (camera:right view) (- dy))
                                          (gvector:scale (camera:up view) dx)))
                         (ang (/ (* (sqrt (+ (* dx dx) (* dy dy))) 360) vpsize))
                         )
                     (camera:orbit axis ang view)
                     ))
                 (set! last-pe pe)
                 (set! last-xyz-pos '())  ;; clear highlight memory
                 )) ; end DS_Rotate
             ; define one rubber-band object to hold mouse tracking function calls
             ; which get executed each time the mouse moves
             ; the mouse up and down hooks are written to change
             ; the callback functions depending on which mouse chord
             ; the user has executed.
             (rbd (rbd:scheme #f rb-procs))
             ) ; end 3rd let define-block - begin 3rd let body
        
        ;; Finished the shared variable and the hook and rbd function
        ;; inits - now build the user executable function which
        ;; binds the hook and rbd functions to global variables
        (lambda (entity . solve_flag)
          ; (rbd:clear) ;; debug remove - causes a double (rbd:clear) call
          ;; switch on input entity type
          (cond
            ;; case input entity not a FACE or EDGE
            ((not (or (face? entity)
                      (edge? entity))) ; set up mouse view manipulations
             ; ;  (rbd:clear)
             ; ;  (set! this-model '())
             ; ;  (set! mouse-up-hook '())
             ;(;  (set! mouse-down-hook '()))
             (set! this-model '())
             (if ds-mtalk (ds:mouse-view-help))
             (rbd:clear)
             (vector-fill! rb-procs '())
             (set! mouse-up-hook
                   (lambda (pe)
                     (rbd:clear)))
             (set! mouse-down-hook
                   (lambda (pe)
                     (DS_view_set pe)
                     (rbd:clear)
                     (cond
                       ((and (event:left? pe) (event:right? pe))
                        (vector-set! rb-procs 2 DS_Pan))
                       ((event:left? pe)
                        (vector-set! rb-procs 2 DS_Rotate))
                       ((event:right? pe)
                        (vector-set! rb-procs 2 DS_Zoom)))
                     (rbd:add rbd)))
             ) ; end model argument not a face or edge branch
            
            ;; case input entity is a FACE or EDGE
            ((or (face? entity)
                 (edge? entity)) ; set up mouse sculpting options
             (set! this-model entity)
             (if ds-mtalk (ds:mouse-help))
             ; the next line does not work on my machine - why?
             ; (env:set-point-style "o")
             (rbd:clear)
             (if (and (not (null? solve_flag))
                      (car solve_flag))
                 (vector-set! rb-procs 2 DS_Highlight_Solve)
                 (vector-set! rb-procs 2 DS_Highlight_Pt))
             (rbd:add rbd)
             (set! mouse-up-hook
                   (lambda (pe)
                     (rbd:clear)
                     ;; (set! last-xyz-pos '()) ;; moved to event callbacks
                     ; ( force a view:repaint )
                     
                     ;; check mouse mode - there may be a function to execute
                     (cond ((= mouse-mode 1)
                            ;; clear the mouse-mode value
                            (set! mouse-mode 0)
                            ;; execute an Add_Pt_Cstrn or an Add_Patch function
                            ;; (display "enter mouse-up-hook add\n")
                            (cond
                              ;; box-u0 and box-u1 are the same
                              ((and (= (par-pos:u box-u0) (par-pos:u box-u1))
                                    (= (par-pos:v box-u0) (par-pos:v box-u1)))
                               (DS_Add_Cstrn_Pt last-pe)) ; end the same
                              ;; last-uv-pos and uv-pos are different
                              ( else (DS_Add_Patch box-u0 box-u1)) ; end different
                              ) ; end switch on same/different last-uv-pos and uv-pos vals
                            )) ; end mouse-mode == 1 check, conditional
                     
                     ;; set rubber-band proc based on solve_flag value
                     (if (and (not (null? solve_flag))
                              (car solve_flag))
                         (vector-set! rb-procs 2 DS_Highlight_Solve)
                         (vector-set! rb-procs 2 DS_Highlight_Pt))
                     ;; make the rubberband procedure set active
                     (rbd:add rbd)
                     )) ; end (set! mouse-up-hook)
             (set! mouse-down-hook
                   (lambda (pe)
                     (DS_view_set pe)
                     (rbd:clear)
                     ; switch on <left-right>, <left>, or <right> mouse chord
                     (cond
                       ; case <left-right>
                       ((and (event:left? pe) (event:right? pe))
                        (vector-set! rb-procs 2 DS_Pan)
                        (rbd:add rbd)
                        ) ; end case <left-right>
                       ; case <left>
                       ((event:left? pe)
                        ; switch on <shift-control>,<shift>,<control>,or plain mouse chord
                        (cond
                          ((and (event:shift? pe) (event:control? pe))
                           ; now switch between sliding and tracking
                             ;(display "shift-control: current-tag-type = ")
                             ;(display current-tag-type)
                             ;(display "\n               current-pt-index = ")
                             ;(display current-pt-index) (display "\n") 
                           (cond
                             ((and (or (= current-tag-type 14)   ; vector-load
                                       (= current-tag-type 8)    ;      pt_cstrn
                                       (= current-tag-type 9))   ; seam pt_cstrn
                                   (not (= current-pt-index 0))) ; an end-pt
                              (vector-set! rb-procs 2 DS_Track_XY_Gain)
                              (set! last-pe pe)
                              (set! independent_track 2)
                              ) ; end track end-pt case 
                             (else 
                               (vector-set! rb-procs 2 DS_Track_Dist_Gain)
                               (set! last-pe pe)
                             )))
                          ((event:shift? pe) (DS_Search_Tgt pe)
                           (vector-set! rb-procs 2 DS_Track_Z_Gain)
                           (set! last-pe pe))
                          ((event:control? pe) (DS_Search_Tgt pe)
                           (vector-set! rb-procs 2 DS_Track_XY_Gain)
                           (set! independent_track 1)
                           (set! last-pe pe))
                          (else (vector-set! rb-procs 2 DS_Rotate)))
                        (rbd:add rbd)
                        ) ; end case <left>
                       ; case <right>
                       ((event:right? pe)
                        ; switch on <shift-control>,<shift>,<control>,or plain mouse chord
                        (cond
                          ; case <shift-control>
                          ((and (event:shift? pe)
                                (event:control? pe))
                           (DS_Rm_Tag pe))
                          ; case <shift>
                          ((event:shift? pe)
                           ; (display "start event:shift\n")
                           (cond
                             ;; toggle highlighted cstrns
                             ((or (= current-tag-type 8)    ;      pt_cstrn
                                  (= current-tag-type 9)    ; seam pt_cstrn
                                  (= current-tag-type 10)   ;      crv_cstrn
                                  (= current-tag-type 6)   ;      crv_load
                                  (= current-tag-type 11)   ; seam crv_cstrn
                                  (= current-tag-type 16)   ; link_cstrn
                                  (= current-tag-type 18)   ; link_load
                                  (= current-tag-type 17))  ; area_cstrn
                              (DS_Toggle_Cstrn)
                              ) ; end cstrn tgt highlighted so toggle it branch
                             
                             ;; wait for mouse-up to add pt_cstrn or patch
                             ;;    initialize box(pt) tracking
                             (else (set! mouse-mode 1) ; tell up-mouse to execute a function
                                   (set! last-pe pe)
                                   (set! box-p0 (ds:pick-position this-model pe ))
                                   (set! box-p1 box-p0)
                                   (set! box-u0 (ds:pick-par-pos this-model pe ))
                                   (set! box-u1 box-u0)
                                   (set! box-tag0 (ds:get-active-patch this-model))
                                   (set! box-tag1 box-tag0)
                                   ;; clear point highlight
                                   (if (not (null? last-xyz-pos))
                                       (begin (DS_Draw_Pt last-xyz-pos)
                                              (set! last-xyz-pos '())
                                              ))
                                   ;; start box highlight
                                   (set! last-box-p0 box-p0)
                                   (DS_Draw_Pt last-box-p0)
                                   ;; set up the rubberband for box tracking
                                   (vector-set! rb-procs 2 DS_Add_Track)
                                   (rbd:add rbd)
                                   ) ; end default branch to add Pt_cstrns and Patches
                             ; use up-mouse to branch between
                             ;      (DS_Add_Cstrn_pt pe) and
                             ;      (DS_Add_Patch last-pe pe)
                             ;; old else clause to just add a Pt_cstrn
                             ; (else (DS_Add_Cstrn_Pt pe))
                             )) ; end case <shift>
                          ; case <control>
                          ((event:control? pe)
                           (DS_Add_Press_Pt pe))
                          ; default case <plain>
                          (else (vector-set! rb-procs 2 DS_Zoom)
                                (rbd:add rbd)) ; end else clause
                          ) ; end cond branching on <shift-control-plain> mouse chord
                        ) ; end case <right>
                       ) ; end cond branching on <left-right> mouse chord
                     )) ; end (set! mouse-down-hook)
             ) ; end case input entity is a FACE or EDGE
            ;; default case - should never be run
            ;; meant to be run when executed with no arguments
            (else (display "syntax: (ds:mouse entity #f)=on no solver or ")
                  (display "        (ds:mouse entity #t)=on with solver or ")
                  (display "        (ds:mouse #f)     =off")
                  ) ; end default case on input entity type branching
            ) ; end cond branching on input entity type
          ) ; end ds:mouse lambda block (the executable logic)
        ) ; end 3rd let block
      ) ; end 2nd let block
    ) ; end 1st let block
  ) ; end (define (mouse))

;;
;;
;; manual doc for
;;      ds:mouse
;;      ds:mouse-help
;;      ds:mouse-view-help
;;      ds:select-face
;;      ds:select-edge
;;      ds:set-mouse-slider
;;      ds:get-mouse-slider
;;
;;
;; ********************************************************************
;;
;; Command:
;;    ds:mouse
;;
;; Action:
;;    binds or clears the binding of an entity to the mouse driven
;;    deformable modeling rubber-band driver. Entities may be
;;    faces or edges.
;;
;; File Name:
;;    ds/scmext/dsscm.cxx
;;
;; Access:
;;    document
;;
;; APIs:
;;    None
;;
;; See Also:
;;    ds:select-face, ds:select-edge, ds:solve, ds:mouse-help
;;
;; Syntax:
;;    (ds:mouse entity [solve_flag])
;;
;; Arg Types:
;;    entity               face or edge
;;    solve_flag           integer
;;
;; Returns:
;;    unspecified
;;
;; Errors:
;;    None
;;
;; Description:
;;    Binds entity to the deformable modeling rubberband driver.  Once
;;    bound the mouse in combination with the shift and ctrl keys
;;    can be used to add and remove constraints, pressure loads, and
;;    patches.  It can be used to track constraint
;;    points in the z direction or in the xy plane.  The mouse can
;;    be used to slide the gain of one specified gain (see
;;    ds:set-mouse-slider).  Additionally, the mouse can modify
;;    the viewing angle.
;;
;;	  Calling ds:mouse with a null argument (e.g. (ds:mouse '())
;;    will bind only the view manipulation commands
;;    to the mouse and clear the deformable
;;    modeling functions.
;;
;;    The mouse functionality includes
;;
;;    move-left-button       = rotate view.
;;    move-right-button	     = zoom view.
;;    move-left-right-button = track view.
;;
;;    move-shift-left-button = track constraint-pt in z-direction.
;;    shift-right-button     = when cursor pts to a constraint,
;;                               toggle constraint enable/disable state
;;                             else add constraint-pt at cursor position.
;;    shift-right-drag-button = Add a square patch whose opposite corners
;;                              are defined by the mouse-down and mouse-up
;;                              events.
;;
;;    move-ctrl-left-button  = track constraint-pt in xy directions.
;;    ctrl-right-button      = add pressure-pt at cursor position.
;;
;;    move-shift-ctrl-left-button = track a load gain.
;;    shift-ctrl-right-button     = remove tag-object at cursor position.
;;
;; Limitations:
;;    Not Applicable
;;
;; Example:
;;    ; ds:mouse
;;
;;    ; define some helpful globals
;;    (define ds-model)
;;
;;    ; build a test square spline face
;;    ;  (6x6 control points, x and y side length = 36)
;;    (set! ds-model (ds:test-face 6 6 36 36 0))
;;    (entity:erase ds-model)	; don't render the face
;;
;;    ; bind this face to the mouse
;;    (ds:mouse ds-model)
;;    ;;
;;    ;;             ds:mouse Function Map\n")
;;    ;; NOTE: Bind a load to the slider function with\n")
;;    ;;       (ds:set-mouse-slider tag gain_inc)\n")
;;    ;; NOTE: Release select keys after mouse moves begin
;;    ;; ---------+-------------+-----------+---------+
;;    ;;          |    Lft      |    Rgt    | Rgt_Lft |
;;    ;; ---------+-------------+-----------+---------+
;;    ;;   Plain  |  RotView    | ZoomView  | PanView |
;;    ;; ---------+-------------+-----------+---------+
;;    ;;   Shift  | Track_Cpt_Z |Add/Tog_Cpt|
;;    ;; ---------+-------------+-----------+
;;    ;; Shft-drag|             | Add_Patch |
;;    ;; ---------+-------------+-----------+
;;    ;;   Ctrl   | Track_Cpt_XY|  Add_Ppt  |
;;	   ;; ---------+-------------+-----------+
;;    ;; Shft_Ctrl|  Slide_gain |  Rm_Tag   |
;;    ;; ---------+-------------+-----------+
;;
;;    ; clear the deformable bindings - save the view manipulations
;;    (ds:mouse '())
;;    ;;
;;    ;;             ds:mouse Function Map\n")
;;    ;;     +-------------+-----------+---------+
;;    ;;     |    Lft      |    Rgt    | Rgt_Lft |
;;    ;;     +-------------+-----------+---------+
;;    ;;     |  RotView    | ZoomView  | PanView |
;;    ;;     +-------------+-----------+---------+
;;
;; ********************************************************************
;;
;;
;; ********************************************************************
;;
;; Command:
;;    ds:mouse-help
;;
;; Action:
;;    Displays the deformable model mouse rubber-band driver help table.
;;
;; File Name:
;;    ds/scmext/dsscm.cxx
;;
;; Access:
;;    document
;;
;; APIs:
;;    None
;;
;; See Also:
;;    ds:add-pt-cstrn, ds:add-pt-press, ds:describe, ds:get-tag-type, ds:pick-tag-id,
;;    ds:sculptable?, ds:set-pt-uv, ds:set-pt-xyz, ds:solve
;;
;; Syntax:
;;    (ds:mouse-help)
;;
;; Arg Types:
;;
;; Returns:
;;    unspecified
;;
;; Errors:
;;    None
;;
;; Description:
;;    Displays the mouse functions established by the command
;;    (ds:mouse face).
;;
;; Limitations:
;;    Not Applicable
;;
;; Example:
;;    ; ds:mouse-help
;;    (ds:mouse-help)
;;    ;;
;;    ;;             ds:mouse Function Map\n")
;;    ;; NOTE: Bind a load to the slider function with\n")
;;    ;;       (ds:set-mouse-slider tag gain_inc)\n")
;;    ;; NOTE: Release select keys after mouse moves begin
;;    ;; ---------+-------------+-----------+---------+
;;    ;;          |    Lft      |    Rgt    | Rgt_Lft |
;;    ;; ---------+-------------+-----------+---------+
;;    ;;   Plain  |  RotView    | ZoomView  | PanView |
;;    ;; ---------+-------------+-----------+---------+
;;    ;;   Shift  | Track_Cpt_Z |Add/Tog_Cpt|
;;    ;; ---------+-------------+-----------+
;;    ;; Shft-drag|             | Add_Patch |
;;    ;; ---------+-------------+-----------+
;;    ;;   Ctrl   | Track_Cpt_XY|  Add_Ppt  |
;;	   ;; ---------+-------------+-----------+
;;    ;; Shft_Ctrl|  Slide_gain |  Rm_Tag   |
;;    ;; ---------+-------------+-----------+
;;
;; ********************************************************************
;;
;;
;; ********************************************************************
;;
;; Command:
;;    ds:mouse-view-help
;;
;; Action:
;;    Displays the deformable model rubber-band
;;    driver functions supported by the command (ds:mouse '())
;;
;; File Name:
;;    ds/scmext/dsscm.cxx
;;
;; Access:
;;    document
;;
;; APIs:
;;    None
;;
;; See Also:
;;    ds:mouse, ds:select-face, ds:select-edge, ds:solve
;;
;; Syntax:
;;    (ds:mouse-view-help)
;;
;; Arg Types:
;;
;; Returns:
;;    unspecified
;;
;; Errors:
;;    None
;;
;; Description:
;;    Displays mouse supported funtions that are established by the
;;    command (ds:mouse '())
;;
;;    The mouse functionality includes
;;
;;    move-left-button       = rotate view.
;;    move-right-button	     = zoom view.
;;    move-left-right-button = track view.
;;
;; Limitations:
;;    Not Applicable
;;
;; Example:
;;    ; ds:mouse-view-help
;;    (ds:mouse-view-help ds-model)
;;    ;;
;;    ;;             ds:mouse Function Map\n")
;;    ;;     +-------------+-----------+---------+
;;    ;;     |    Lft      |    Rgt    | Rgt_Lft |
;;    ;;     +-------------+-----------+---------+
;;    ;;     |  RotView    | ZoomView  | PanView |
;;    ;;     +-------------+-----------+---------+
;;
;; ********************************************************************
;;
;;
;; ********************************************************************
;;
;; Command:
;;    ds:select-face
;;
;; Action:
;;    Selects a face from a solid model and prepares it for deformable
;;    modeling.
;;
;; File Name:
;;    ds/scmext/dsscm.cxx
;;
;; Access:
;;    document
;;
;; APIs:
;;    None
;;
;; See Also:
;;    ds:mouse, ds:select-edge, ds:solve, ds:add-pt-cstrn
;;
;; Syntax:
;;    (ds:select-face)
;;
;; Arg Types:
;;
;; Returns:
;;    unspecified
;;
;; Errors:
;;    None
;;
;; Description:
;;    Prompts for a pick-event, which is used to select a face from
;;    a solid model for deformable editing.  When the pick-event
;;    successfully selects a face, that face is bound to the mouse
;;    with (ds:mouse selected-face), and is bound to the global
;;    variable ds-model so that all the convenience routines provided
;;    in the file dsdemo.scm will work on the selected-face.
;;
;; Limitations:
;;    Not Applicable
;;
;; Example:
;;    ; ds:select-face
;;
;;    ; Select one face out of a solid to sculpt
;;    (ds:select-face)
;;    ;;  Pick Face to Sculpt:
;;
;;    ; the end-user places the cursor over a face and picks
;;    ; with the left mouse.
;;
;;    ;; #[entity 5 1] constructed new attrib_ds2acis
;;    ;;    now bound to ds-model
;;    ;;             ds:mouse Function Map
;;    ;; NOTE: Bind a load to the slider function with
;;    ;;       (ds:set-mouse-slider tag gain_inc)
;;    ;; NOTE: Release select keys after mouse moves begin
;;    ;;
;;    ;; ---------+-------------+-----------+---------+
;;    ;;          |    Lft      |    Rgt    | Rgt_Lft |
;;    ;; ---------+-------------+-----------+---------+
;;    ;;   Plain  |  RotView    | ZoomView  | PanView |
;;    ;; ---------+-------------+-----------+---------+
;;    ;;   Shift  | Track_Cpt_Z |Add/Tog_Cpt|
;;    ;; ---------+-------------+-----------+
;;    ;; Shft_drag|             | Add_Patch |
;;    ;; ---------+-------------+-----------+
;;    ;;   Ctrl   | Track_Cpt_XY|  Add_Ppt  |
;;    ;; ---------+-------------+-----------+
;;    ;; Shft_Ctrl|  Slide_gain |  Rm_Tag   |
;;    ;; ---------+-------------+-----------+
;;
;;
;; ********************************************************************
;;
;;
;; ********************************************************************
;;
;; Command:
;;    ds:select-edge
;;
;; Action:
;;    Selects an edge from a wire model and prepares it for deformable
;;    modeling.
;;
;; File Name:
;;    ds/scmext/dsscm.cxx
;;
;; Access:
;;    document
;;
;; APIs:
;;    None
;;
;; See Also:
;;    ds:mouse, ds:select-face, ds:solve, ds:add-pt-cstrn
;;
;; Syntax:
;;    (ds:select-edge)
;;
;; Arg Types:
;;
;; Returns:
;;    unspecified
;;
;; Errors:
;;    None
;;
;; Description:
;;    Prompts for a pick-event, which is used to select an edge from
;;    a wire model for deformable editing.  When the pick-event
;;    successfully selects an edge, that edge is bound to the mouse
;;    with (ds:mouse selected-edge), and is bound to the global
;;    variable ds-model so that all the convenience routines provided
;;    in the file dsdemo.scm will work on the selected-edge.
;;
;; Limitations:
;;    Not Applicable
;;
;; Example:
;;    ; ds:select-edge
;;
;;    ; Select one edge out of a wire model to sculpt
;;    (ds:select-edge)
;;    ;;  Pick edge to Sculpt:
;;
;;    ; the end-user places the cursor over an edge and picks
;;    ; with the left mouse.
;;
;;    ;; #[entity 5 1] constructed new attrib_ds2acis
;;    ;;    now bound to ds-model
;;    ;;             ds:mouse Function Map
;;    ;; NOTE: Bind a load to the slider function with
;;    ;;       (ds:set-mouse-slider tag gain_inc)
;;    ;; NOTE: Release select keys after mouse moves begin
;;    ;;
;;    ;; ---------+-------------+-----------+---------+
;;    ;;          |    Lft      |    Rgt    | Rgt_Lft |
;;    ;; ---------+-------------+-----------+---------+
;;    ;;   Plain  |  RotView    | ZoomView  | PanView |
;;    ;; ---------+-------------+-----------+---------+
;;    ;;   Shift  | Track_Cpt_Z |Add/Tog_Cpt|
;;    ;; ---------+-------------+-----------+
;;    ;; Shft_drag|             | Add_Patch |
;;    ;; ---------+-------------+-----------+
;;    ;;   Ctrl   | Track_Cpt_XY|  Add_Ppt  |
;;    ;; ---------+-------------+-----------+
;;    ;; Shft_Ctrl|  Slide_gain |  Rm_Tag   |
;;    ;; ---------+-------------+-----------+
;;
;;
;; ********************************************************************
;;
;;
;; ********************************************************************
;;
;; Command:
;;    ds:set-mouse-slider
;;
;; Action:
;;    Binds a tag load number to the mouse driven slider bar in
;;    preparation of animation like sculpting.
;;
;; File Name:
;;    ds/scmext/dsscm.cxx
;;
;; Access:
;;    document
;;
;; APIs:
;;    None
;;
;; See Also:
;;    ds:add-pt-cstrn, ds:add-pt-press, ds:describe, ds:get-tag-type, ds:pick-tag-id,
;;    ds:sculptable?, ds:set-pt-uv, ds:set-pt-xyz, ds:solve
;;
;; Syntax:
;;    (ds:set-mouse-slider tag gain-range)
;;
;; Arg Types:
;;    tag            integer
;;    gain-range     real
;;
;; Returns:
;;    unspecified
;;
;; Errors:
;;    None
;;
;; Description:
;;    Binds values to the global variables, data-ds:mouse-slider-tag and
;;    data-ds:mouse-slider-gain-inc.  These two variables are used
;;    by the mouse slider bar function, move-shift-ctrl-left-button.
;;    Each time the mouse moves while the shift, ctrl, and left buttons
;;    are depressed the deformable rubberband driver computes a new
;;    gain value, assigns that value to the tag identified tag-object,
;;    resolves the deformable equations, and displays the result.
;;    Moving the mouse fully across the screen from left to right
;;    will increase the gain value by an amount of gain-range.  Moving
;;    from right to left will decrease that value.
;;
;; Limitations:
;;    Not Applicable
;;
;; Example:
;;    ; ds:set-mouse-slider
;;
;;    ; define some helpful globals
;;    (define ds-model)
;;
;;    ; build a test square spline face
;;    ;  (6x6 control points, x and y side length = 36)
;;    (set! ds-model (ds:test-face 6 6 36 36 0))
;;    (entity:erase ds-model)	; don't render the face
;;
;;    ; bind the face to the mouse
;;    (ds:mouse ds-model)
;;
;;    ; add a pressure load
;;    (ds:add-dist-press ds-model 1 0)
;;    ;; (5)
;;
;;    ; bind this load to the slider bar
;;    (ds:set-mouse-slider 5 10000)
;;
;;    ; hold the shift and ctrl keys down. depress and hold the
;;    ; the left mouse button down.  Moving the cursor from
;;    ; left to right and back again will deform the surface
;;    ; in a continuous manner.
;;
;; ********************************************************************
;;
;;
;; ********************************************************************
;;
;; Command:
;;    ds:get-mouse-slider
;;
;; Action:
;;    Returns the current tag value and slider bar range in use
;;    for the mouse driven slider bar used by the deformable
;;    surfaces mouse package.
;;
;; File Name:
;;    ds/scmext/dsscm.cxx
;;
;; Access:
;;    document
;;
;; APIs:
;;    None
;;
;; See Also:
;;    ds:set-mouse-slider
;;
;; Syntax:
;;    (ds:get-mouse-slider)
;;
;; Returns:
;;    (tag gain-range)
;;
;; Return Types:
;;    tag            integer
;;    gain-range     real
;;
;; Errors:
;;    None
;;
;; Description:
;;    Returns the current values bound
;;    to the global variables, data-ds:mouse-slider-tag and
;;    data-ds:mouse-slider-gain-inc.  These two variables are used
;;    by the mouse slider bar funtion, move-shift-ctrl-left-button.
;;    Each time the mouse moves while the shift, ctrl, and left buttons
;;    are depressed the deformable rubberband driver computes a new
;;    gain value, assigns that value to the tag identified tag-object,
;;    resolves the deformable equations, and displays the result.
;;    Moving the mouse fully acrioss the screen from left to right
;;    will increase the gain value by an amount of gain-range.  Moving
;;    from right to left will decrease that value.
;;
;; Limitations:
;;    Not Applicable
;;
;; Example:
;;    ; ds:get-mouse-slider
;;
;;    ; define some helpful globals
;;    (define ds-model)
;;
;;    ; build a test square spline face
;;    ;  (6x6 control points, x and y side length = 36)
;;    (set! ds-model (ds:test-face 6 6 36 36 0))
;;    (entity:erase ds-model)	; don't render the face
;;
;;    ; bind the face to the mouse
;;    (ds:mouse ds-model)
;;
;;    ; add a pressure load
;;    (ds:add-dist-press ds-model 1 0)
;;    ;; (5)
;;
;;    ; bind this load to the slider bar
;;    (ds:set-mouse-slider 5 10000)
;;
;;    ; hold the shift and ctrl keys down. depress and hold the
;;    ; the left mouse button down.  Moving the cursor from
;;    ; left to right and back again will deform the surface
;;    ; in a continuous manner.
;;
;;    ; check the curren mouse slider bar values
;;    (ds:get-mouse-slider)
;;    ;; (5 10000)
;;
;; ********************************************************************
